module ground_control
  !
  ! Command Line Parser
  !
  !
  ! LICENSE AGREEMENT:
  !
  ! You agree that we don't agree to anything.
  !
  !
  ! DISCLAIMER OF WARRANTIES:
  !
  ! This software is provided to you "AS IS," and the authors and
  ! contributors disclaim any warranty or liability obligations to you
  ! of any kind, implied or express, including but not limited to the
  ! warranties of merchantability, fitness for a particular purpose,
  ! and non-infringement.
  ! 
#define green(i) (iand(mana,i)/=0)
  implicit none
  private

  integer,public,protected :: mana = 0
  include "meliy.f90"

  public me_first_mana
  public echo_v
  public echo_green,echo_red
  public initShm
  public setProg
  public proc_output
  public getProcname
  public writeImageShm

  public t_opet_env
  type t_opet_env
     integer num_multiray
     integer num_line_sampling
     integer number_of_iteration
     real threshold_of_Cj
     integer maxdd
     integer maxcd
     integer number_of_subsets
     real beta
     real D
     real R
     real dz
     integer nt,na
     real cf ! calibration factor
     character(MAX_LEN_FILENAME),pointer::fhp,fhd,fht
  end type t_opet_env
  
  public t_cmd_info
  type t_cmd_info
     integer narg
     character*1,allocatable::args(:)
     character(MAXPATHLEN) fout
     character(MAXPATHLEN) fcj
     integer,allocatable::argindxfile(:) ! holds filetype
     character(MAXSTRLEN) ofmt ! output format
     character*4 oext
     integer ofmtid
     integer nfin
     type(t_opet_env) pet
  end type t_cmd_info

  !
  type t_shmstat
     integer(qp) p
     integer(qp) max_size
     integer(qp) size
  end type t_shmstat
  integer::preconstat=0
  type(t_shmstat),target::shmstats(0:nshm)

  integer,target::shmid=0
  integer::pid=0
  integer::exit_code=0

  character(MAXPATHLEN)::me=""
  character(MAXPATHLEN),target::output_dir=""
  character(MAXPATHLEN),target::output_prefix=""
  character(MAXPATHLEN),target::output_postfix=""
  character(MAXPATHLEN),target::cwd=""

  !
  integer,parameter,public::sp=selected_real_kind(6,37)
  integer,parameter,public::dp=selected_real_kind(15,307)
  
contains

  !
  subroutine print_info(to)
    integer,intent(in)::to
    write(*,1) PROGRAM//" "//VERSION
    if(to<=1) return
    write(*,1) COPYRIGHT//"\n"
    if(to<=2) return
    write(*,1) "Build at "//BUILD_TIME//" on "//HOST_NAME//"\n"
    if(to<=3) return
    write(*,1) NOTICE
1   format(a)
  end subroutine print_info

  !
  subroutine print_usage
    write(*,"(a)") USAGE
  end subroutine print_usage

  !
  subroutine echo(mess,put_time)
    use suty
    character*(*),intent(in)::mess
    logical,intent(in),optional::put_time
    if(.not.green(OPT_VERBOSE)) return
    call echo_green(mess,"","GC",put_time)
  end subroutine echo
  
  !
  subroutine me_first_mana(ci)
    use suty
    type(t_cmd_info),intent(inout),target::ci
    integer narg
    integer ia,ls,io
    character(MAXSTRLEN) str,str_old
    integer,pointer::iopt, in
    real,pointer::ropt
    character(MAXPATHLEN),pointer::sopt
    integer istat
    integer ft

    pid=getpid()
    call pid2bin(pid,loc(me))
    call init_sig
    call init_shmstats
    call init_ci
    narg = command_argument_count()
    
    if(narg==0) then
       call print_info(2)
       call print_usage
       call exit(0)
    end if
    
    ci%narg=narg
    call save_command()
    allocate(ci%argindxfile(narg))
    ci%argindxfile=0
    ft=1

    nullify(iopt,sopt,ropt,in)

    str=""
    do ia=1,narg
       str_old=str
       call get_command_argument(ia,str,ls)
       str=adjustl(str)
       if(read_args()) cycle

       if(ls>1.and.str(1:1)=="-") then
          if(str(2:2)=="-") then
             if(ls>2) then
                select case(str(3:ls))
                case("auto-set-filename-extension")
                   mana = ior(mana,OPT_ASFE)
                case("cf")
                   ropt => ci%pet%cf
                case("debug")
                   mana = ior(mana, OPT_DEBUG)
#ifdef _DEBUG_
                case("lmf-swap-at")
                   mana = ior(mana, OPT_LMF_SWAP_AT)
                case("lmf-flip-axial")
                   mana = ior(mana, OPT_LMF_FLIP_AXIAL)
                case("lmf-flip-taxial")
                   mana = ior(mana, OPT_LMF_FLIP_TAXIAL)
                case("lmf-flip-pmtid")
                   mana = ior(mana, OPT_LMF_FLIP_PMTID)
#endif
                case("ofmt")
                   sopt => ci%ofmt
                case("oprefix")
                   sopt => output_prefix 
                case("opostfix")
                   sopt => output_postfix
                case("show-cpu")
                   mana = ior(mana, OPT_VERBOSE)
                   call showCpuInfo
                   call exit(0)
                case("use-snn")
                   mana = ior(mana, OPT_USE_SNN)
                case("write-Cj")
                   sopt => ci%fcj
                case("write-hist-delayed")
                   allocate(ci%pet%fhd)
                   sopt => ci%pet%fhd
                case("write-hist-prompt")
                   allocate(ci%pet%fhp)
                   sopt => ci%pet%fhp
                case("write-hist-true")
                   allocate(ci%pet%fht)
                   sopt => ci%pet%fht
                case default
                   call echo_red("*** Invalid option: "//trim(str))
                end select                
             else
                call echo_red("*** Invalid option: "//trim(str))
             end if
          else
             do io=2,ls
                select case(str(io:io))
                case("A")
                   mana = ior(mana, OPT_ASFE)
                case("B")
                   mana = ior(mana, OPT_BATCH)
                case("C")
                   sopt => cwd
                case("D")
                   ropt => ci%pet%D
                case("L")
                   mana = ior(mana, OPT_SHOW_LOGL)
                case("M")
                   mana = ior(mana, OPT_USE_SHM)
                   iopt => shmid
                case("N")
                   iopt => ci%pet%number_of_iteration
                case("O")
                   sopt => output_dir
                case("R")
                   ropt => ci%pet%R
                case("S")
                   iopt => ci%pet%number_of_subsets
                case("Z")
                   ropt => ci%pet%dz
                case("V")
                   call print_info(4)
                   call exit(0)
                case("a")
                   iopt => ci%pet%maxcd
                case("b")
                   ropt => ci%pet%beta
                   mana = ior(mana, OPT_USE_MRP)
                case("c")
                   mana = ior(mana, OPT_PRINT_STAT)
                case("d")
                    iopt => ci%pet%maxdd
                case("f")
                   mana = ior(mana, OPT_FORCE_OVERWRITE)
                case("h")
                   call print_usage
                   call exit(0)
                case("i")
                   ft = FT_HIST
                   in => ci%argindxfile(ia+1)
                case("l")
                   ft = FT_LIST
                   in => ci%argindxfile(ia+1)
                case("s")
                   iopt => ci%pet%num_line_sampling
                case("m")
                   iopt => ci%pet%num_multiray
                case("o")
                   sopt => ci%fout
                case("p")
                   ropt => ci%pet%threshold_of_Cj
                case("q")
                   call gc_veto_c(OPT_VERBOSE)
                case("t")
                   mana = ior(mana, OPT_DECAY_CORRECTION)
                case("u")
                   mana = ior(mana, OPT_CALIBRATION)
                case("v")
                   mana = ior(mana, OPT_VERBOSE)
                case("w")
                   mana = ior(mana, OPT_WRITE_EACH)
                case("x")
                   iopt => ci%pet%nt
                case("y")
                   iopt => ci%pet%na
                case("4")
                   mana = ior(mana, OPT_READ_HIST_INT4)
                case default
                   call echo_red("*** Invalid option: "//trim(str))
                end select
             end do
          end if
       else
          ci%argindxfile(ia)=ft
          ci%nfin = ci%nfin + 1
       end if
    end do

    if(associated(iopt).or.associated(sopt)&
         .or.associated(ropt).or.associated(in)) call echo_red("*** missing argument for option: "//trim(str))

    call gc_veto(ci)

  contains
    
    subroutine save_command()
      character*1 c
      integer len
      if(allocated(ci%args)) deallocate(ci%args)
      call get_command(c,len)
      if(len<=0) return
      allocate(ci%args(len))
      call cp_command(len)
    end subroutine save_command

    subroutine cp_command(len)
      integer,intent(in)::len
      character(len) com
      call get_command(com)
      call cpmems1(loc(ci%args),loc(com),len)
    end subroutine cp_command

    logical function read_args()
      read_args=.true.
      istat=0
      if(associated(iopt)) then
         read(str,*,iostat=istat) iopt
         nullify(iopt)
      else if(associated(sopt)) then
         sopt=str
         nullify(sopt)
      else if(associated(ropt)) then
         read(str,*,iostat=istat) ropt
      nullify(ropt)
      else if(associated(in)) then
         in = ft
         ci%nfin=ci%nfin+1
         nullify(in)
      else
         read_args=.false.
      end if
      if(istat/=0) call echo_red("*** invalid argument: "//trim(str)//" for option "//trim(str_old))
    end function read_args
    
    subroutine init_sig
      use suty
      call setup_SIGTERM(loc(proc_term))
    end subroutine init_sig
    
    subroutine init_shmstats
      shmstats%p=0
      shmstats%size=0
      shmstats%max_size=0
    end subroutine init_shmstats

    subroutine init_ci
      ci%fout=""
      ci%fcj=""
      ci%nfin=0
      ci%ofmt=valid_ofmt(1)
      ci%oext=""
      ci%ofmtid=0
      if(allocated(ci%argindxfile)) deallocate(ci%argindxfile)
      ci%pet%number_of_iteration=1
      ci%pet%number_of_subsets=0
      ci%pet%num_multiray=1
      ci%pet%num_line_sampling=1
      ci%pet%maxdd=-1
      ci%pet%maxcd=-1
      ci%pet%D=0.
      ci%pet%R=0.
      ci%pet%na=0
      ci%pet%nt=0
      ci%pet%beta=0.
      ci%pet%dz=0.
      ci%pet%cf=1.
    end subroutine init_ci
    
  end subroutine me_first_mana

  !
  subroutine gc_veto_mod(i,set)
    use suty
    integer,intent(in)::i
    logical,intent(in)::set
    character*64 str
    character*8 com
    integer k
    if(set) then
       k=ior(mana,i)
       com="SET"
    else
       k=iand(mana,not(i))
       com="CLEAR"
    end if
    if(k/=mana) then
       str="*** WARNING, GC-VETO "//trim(com)//" CODE, "//trim(i2a(i,hex=.true.))
       call echo(str)
       mana = k
    end if
  end subroutine gc_veto_mod
  !
  subroutine gc_veto_c(i)
    integer,intent(in)::i
    call gc_veto_mod(i,.false.)
  end subroutine gc_veto_c
  !
  subroutine gc_veto_s(i)
    integer,intent(in)::i
    call gc_veto_mod(i,.true.)
  end subroutine gc_veto_s

  subroutine gc_veto(ci)
    use suty
    type(t_cmd_info),intent(inout)::ci
    integer i,k
    character(MAXPATHLEN) f

    call showCmdline(size(ci%args))

    if(cwd/="") then
       call chdir(cwd,i)
       if(i/=0) call echo_red("*** cannot chdir to "//trim(cwd))
    else
       call getcwd(cwd)
    end if
    call echo("Current direcotry: "//trim(cwd))

    if(ci%nfin==0) call echo_red("*** No input file.")

    do i=1,ci%narg
       if(ci%argindxfile(i)==0) cycle
       call get_command_argument(i,f)
       if(access(f,"r")/=0) then
          call echo_red("*** Cannot read input file: "//trim(f))
       end if
    end do

    if(output_dir/="") then
       i=len_trim(output_dir)
       if(output_dir(i:i)/="/".and.i<len(output_dir)) then
          i=i+1
          output_dir(i:i)="/"
       end if
    end if

    if(green(OPT_BATCH)) then
       if(ci%fout/="") call echo_red("*** You cannot specify output file in batch mode.")
    else
       if(ci%fout=="") call echo_red("*** No output file.")
       i=len_trim(ci%fout)
       if(ci%fout(i:i)=="/") call echo_red("*** invalid output file: "//trim(ci%fout))
    end if
    
    do i=1,nofmt
       if(trim(ci%ofmt)==trim(valid_ofmt(i))) then
          ci%oext=ofmt_ext(i)
          ci%ofmtid=i
          exit
       end if
    end do
    if(ci%oext=="") call echo_red("*** invalid output format: "//trim(ci%ofmt))
    
    if(green(OPT_WRITE_EACH)) then
       k=ci%pet%number_of_iteration
    else
       k=-1
    end if
    if(.not.green(OPT_BATCH)) then
       call proc_output(ci%fout,f,ci%oext,k)
       if(ci%ofmtid==OFMT_ANA) call proc_output(ci%fout,f,".hdr",k)
    else
       do i=1,ci%narg
          if(ci%argindxfile(i)==0) cycle
          call get_command_argument(i,f)
          call proc_output(f,ci%fout,ci%oext,k)
          if(ci%ofmtid==OFMT_ANA) call proc_output(f,ci%fout,".hdr",k)          
       end do
    end if

    if(ci%pet%D<=0) call echo_red("*** invalid detector separation: "//trim(f2a(ci%pet%D)))
    if(ci%pet%na<=0) call echo_red("*** invalid number of crysal in axial: "//trim(i2a(ci%pet%na)))
    if(ci%pet%nt<=0) call echo_red("*** invalid number of crystal in transaxial: "//trim(i2a(ci%pet%nt)))

    call showCpuInfo

  contains 
    
    subroutine showCmdline(len)
      integer,intent(in)::len
      character(len) str
      call cpmems1(loc(str),loc(ci%args),len)
      call echo("Begin: "//str,.true.)
    end subroutine showCmdline
    
  end subroutine gc_veto

  subroutine showCpuInfo
    use suty
    character(MAXSTRLEN)::cstr
    character(MAXSTRLEN)::dstr
    integer*4 reg
    integer i
    integer,parameter::en=9
    integer::ebit(en)=[0,9,12,18,19,20,25,27,28]
    character*7::estr(en)=[&
         "sse3   ",&
         "ssse3  ",&
         "fma    ",&
         "dca    ",&
         "sse4.1 ",&
         "sse4.2 ",&
         "aesni  ",&
         "osxsave",&
         "avx    "]
    integer,parameter::fn=7
    integer::fbit(fn)=[0,15,23,24,25,26,28]
    character*4::fstr(fn)=[&
         "fpu ",&
         "cmov",&
         "mmx ",&
         "fxsr",&
         "sse ",&
         "sse2",&
         "htt "]
   
    if(.not.green(OPT_VERBOSE)) return

    call getPBS(cstr)

    dstr=""
    reg=cpuidd(int(1,4))
    do i=1,fn
       dstr=trim(dstr)//" "//trim(fstr(i))//" "//trim(isOn(reg,fbit(i)))//","
    end do

    reg=cpuidc(int(1,4))
    do i=1,en
       dstr=trim(dstr)//" "//trim(estr(i))//" "//trim(isOn(reg,ebit(i)))//","
    end do
    
    dstr=trim(dstr)//" "//trim("daz")//" "//isOn(ckdaz(),0)   

    dstr=trim(dstr)//"."
    call echo("Processor: "//trim(cstr)//": "//trim(adjustl(dstr)))
    
    contains
      
      character*4 function isOn(a,b)
        integer*4,intent(in):: a
        integer,intent(in)::b
        if(btest(a,b)) then
           isOn="ok"
        else
           isOn="off"
        end if
      end function isOn

      integer*4 function ckdaz()
        integer*4::buf(128)
        integer istat
        ckdaz=0_4
        buf=int(0,4)
        call fxsave(loc(buf))
        if(btest(buf(8),6)) then
           ckdaz=1_4
           call setdaz(loc(istat))
        end if
      end function ckdaz
      
  end subroutine showCpuInfo

  subroutine echo_v(nv,pv,mess)
    use suty
    integer,intent(in)::nv,pv
    character*(*),intent(in)::mess
    character(MAXSTRLEN) str
    real*8 v(*)
    pointer(p,v)
    if(green(OPT_PRINT_STAT)) then
       p=pv
       str = ": sum/max = "//trim(f2a(sum(v(1:nv))))//" / "//trim(f2a(maxval(v(1:nv))))
       call echo_green(mess//trim(str))
    end if
  end subroutine echo_v
  
  !
  subroutine initShm()
    use suty
    integer id,p0
    integer sz
    integer(qp) qw
    type(t_shmstat),pointer::shmt
    integer num_block
    integer(qp) offsets(*)
    character*128 str
    integer(qp) pmax
    pointer(pqw,qw)
    pointer(pof,offsets)

    p0=open_shm(sz,id)
    call echo("initShm: id = "//trim(i2a(id))//", rsvd = "//trim(i2a(sz)))

    shmid = id
    shmt => shmstats(SHMID_TOP)
    shmt%p = p0
    pqw=p0
    shmt%max_size=qw
    pmax=p0+qw-1
    pqw=p0+8
    num_block=qw

    if(num_block==0) then
       call getenv("RP3SHMOFFIMAG",str)
       if(str/="") call setShmstat(SHMID_OUT,a2i(str))
       call getenv("RP3SHMOFFHIST",str)
       if(str/="") call setShmstat(SHMID_IN,a2i(str))
       call getenv("RP3SHMOFFRECON",str)       
       if(str/="") call setShmstat(SHMID_ENV,a2i(str))
    else
       pof = p0+8*2
       if(num_block>=1) call setShmstat(1)
       if(num_block>=2) call setShmstat(2)
       if(num_block>=3) call setShmstat(3)
    end if
    shmt%size=num_block

  contains
    
    subroutine setShmstat(sid,off)
      integer,intent(in)::sid
      integer,intent(in),optional::off
      type(t_shmstat),pointer::shms
      integer os
      shms => shmstats(sid)
      if(present(off)) then
         os = off
      else
         os = offsets(sid)
      end if
      if(os>0) then
         shms%p = p0+os
         if(shms%p>pmax-16) call echo_red("setShmstat: invalid address")
         pqw = shms%p
         shms%max_size=qw
         pqw = pqw + 8
         shms%size=qw
      else
         shms%p = 0
         shms%size=0
         shms%max_size=0
      end if
    end subroutine setShmstat
        
  end subroutine initShm  

  !
  integer function open_shm(size,id)
    use suty
    integer,intent(out)::size
    integer,intent(out)::id    
    integer p
    integer(qp) qw
    pointer(pqw,qw)
    open_shm=0
    id=shmid
    p=bsdshmat(id,0,0)
    open_shm = p
    pqw = p
    if(p<=0) call echo_red("shmat: "//trim(i2a(geterrnoa())))
    size = qw
  end function open_shm
  
  subroutine proc_term
    call setProg(SHMENV_DESERTED)
    call exit(exit_code)
  end subroutine proc_term
  
  !
  character*13 function time_stamp()
    time_stamp=""
    call date_and_time(time=time_stamp)
    time_stamp="["//time_stamp(1:2)//":"//time_stamp(3:4)&
         //" "//time_stamp(5:9)//"]"
  end function time_stamp 

  !  
  subroutine echo_green(m,proc,caller,put_time,no_nl)
    character*(*),intent(in)::m
    character*(*),intent(in),optional::proc
    character*(*),intent(in),optional::caller
    logical,intent(in),optional::put_time
    integer,intent(in),optional::no_nl
    character(MAXSTRLEN) str
    if(present(put_time).and.put_time) then
       write(*,20) time_stamp()
20     format(x,a,$)
    end if    
    if(present(proc).and.proc/="") then
       str=trim(proc)//": "//trim(m)
    else
       str=trim(m)
    end if
    if(present(caller)) then
       str="("//trim(caller)//") "//trim(str)
    end if
    if(present(no_nl).and.iand(no_nl,2)/=0) then
       write(*,*)
    end if
    if(present(no_nl).and.iand(no_nl,1)/=0) then
       write(*,11) trim(str)
    else
       write(*,10) trim(str)
    end if
    call flush(6)
10  format(x,a)
11  format(x,a,$)
  end subroutine echo_green

  !
  subroutine echo_red(msg,code)
    use suty
    character*(*),intent(in),optional::msg
    integer,intent(in),optional::code
    character*(*),parameter::swan_song="\n*** mission aborted.\n"
    exit_code=-1
    if(present(code)) exit_code=code
    if(present(msg))  call errmess(trim(adjustl(msg)))
    call errmess(swan_song)
    call kill(pid,SIGINT)
  end subroutine echo_red

  subroutine setProg(iprog)
    integer,intent(in)::iprog
    integer*8 q
    pointer(p,q)
    if(shmstats(SHMID_ENV)%p>0) then
       p=shmstats(SHMID_ENV)%p
       q=iprog
    end if
  end subroutine setProg
  
  subroutine proc_output(fin,fout,ext,k,j,asfe)
    use suty
    character*(*),intent(in)::fin
    character*(*),intent(out)::fout
    character*4,intent(in)::ext
    integer,intent(in),optional::k,j
    logical,intent(in),optional::asfe
    character(MAXSTRLEN) smod,msg
    integer p,lm
    integer istat
    logical doasfe

    doasfe=green(OPT_ASFE)
    if(present(asfe)) doasfe=asfe

    smod=output_postfix
    if(present(k).and.k>=0) smod="-"//i2a(k)
    if(present(j).and.j>=0) smod=trim(smod)//"_"//i2a(j)   
    smod=trim(smod)//ext
    lm=len_trim(smod)
    fout=fin
    if(doasfe.or.green(OPT_BATCH)) then
       p=toExtenstion(fin)
       if(len(fout)>=p+lm-1) then
          fout(1:p+lm-1)=fin(1:p-1)//smod(1:lm)
          fout(p+lm:)=""
       end if
    end if

    if(output_dir/="") then
       p=index(fout,"/",.true.)       
       if(p/=0.and.p<len(fout)) fout=trim(output_dir)//fout(p+1:len_trim(fout))
    end if

    if(output_prefix/="") then
       p=index(fout,"/",.true.)
       if(p/=0) then
          fout=fout(1:p)//trim(output_prefix)//fout(p+1:)
       else
          fout=trim(output_prefix)//trim(fout)
       end if
    end if

    if(.not.green(OPT_FORCE_OVERWRITE)) then
       open(unit=100,file=fout,status="new",access="stream",iostat=istat,iomsg=msg)
       if(istat==0) then
          close(100)
          call unlink(fout)
       else
          call echo_red("*** "//msg)
       end if
    end if

  end subroutine proc_output
  
  character(MAXPROCLEN) function getProcname(s)
    character*(*),intent(in)::s
    integer i
    getProcname=""
    do i=1,len_trim(s)       
       if(s(i:i)==" ") return
       if(s(i:i)==":") then
          if(i==1) return
          getProcname=s(1:i-1)
          exit
       end if
    end do
  end function getProcname
  
  !
  subroutine writeImageShm(pvec,nvec,width,height,number_of_slices,dx,dy,slice_thickness)
    use suty
    integer,intent(in)::pvec
    integer,intent(in)::nvec
    integer,intent(in)::width,height,number_of_slices
    real,intent(in)::dx,dy,slice_thickness
    real*4 buf(nvec)
    integer*8 fs
    integer p
    integer*4 dw
    real*4 st
    real*8 img(*)
    pointer(pimg,img)
    
    ! | int8 max_size | int8 size | int4 width | int4 height | int4 number_of_slices |
    ! | real4 dx | real4 dy | real4 slice_width | real4 0 | real4 data |

    if(shmstats(SHMID_OUT)%p==0) then
       call echo("writeImageShm: not ready")
       return
    end if

    fs=width*height*number_of_slices*4
    if(shmstats(SHMID_OUT)%max_size<fs) then
       call echo("writeImageShm: shm too small")
       return
    end if

    p=cpmemf8(shmstats(SHMID_OUT)%p+8,loc(fs),1)

    dw=int(width,4)
    p=cpmemf4(p,loc(dw),1)
    dw=int(height,4)
    p=cpmemf4(p,loc(dw),1)
    dw=int(number_of_slices,4)
    p=cpmemf4(p,loc(dw),1)
    dw=0_4
    p=cpmemf4(p,loc(dw),1)

    st=real(dx,4)
    p=cpmemf4(p,loc(st),1)
    st=real(dy,4)
    p=cpmemf4(p,loc(st),1)
    st=real(slice_thickness,4)
    p=cpmemf4(p,loc(st),1)
    st=0_4
    p=cpmemf4(p,loc(st),1)
    
    pimg=pvec
    buf(1:nvec)=real(img(1:nvec),4)
    p=cpmemf4(p,loc(buf),nvec)

    call echo("writeImageShm: image saved on shm")
  end subroutine writeImageShm

end module ground_control
